home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / byt86oct.arc / ALLOC.ARC / ALLOC4.MOD < prev    next >
Text File  |  1985-07-12  |  14KB  |  472 lines
  1. IMPLEMENTATION MODULE Alloc4;
  2.  
  3. (* A storage allocator that tries to be safe about freed blocks.
  4.    It uses capabilities to keep track of blocks.
  5.    It also compacts space, and allows resizing.
  6.    A capability is a generation count and an offset into the heap.  The offset
  7.    is used to find the master capability.
  8.    Copyright 1986 by Jonathan Amsterdam.  All Rights Reserved. *)
  9.  
  10. FROM SYSTEM IMPORT WORD, ADDRESS, TSIZE, ADR;
  11. FROM MachineSpecific IMPORT getHeapBottom, getHeapTop, bytesPerWord,
  12.     address, cardinal, addrLessThan, writeAddress, addWords, subtractWords,
  13.     maxAddress;
  14. FROM MyTerminal IMPORT fatal, WriteLnString, WriteCard,
  15.     WriteString, WriteLn;
  16.  
  17. CONST maxIndex = 32767;
  18.       nMasters = 10;  (* number of masters to allocate each time more needed *)
  19.  
  20. TYPE capability = ADDRESS;
  21.      capRec = RECORD        (* used to get the components of a capability *)
  22.         CASE BOOLEAN OF
  23.             TRUE: genCount:CARDINAL;
  24.               offset: CARDINAL;
  25.         |   FALSE: cap:capability;
  26.         END;
  27.           END;
  28.      handle = POINTER TO masterCap;
  29.      blockPtr = POINTER TO block;
  30.      masterCap = RECORD
  31.             genCount:CARDINAL;
  32.             CASE BOOLEAN OF
  33.             TRUE: nextMaster:handle;
  34.             |    FALSE: blockp:blockPtr;
  35.             END;
  36.          END;
  37.      block = RECORD
  38.          size:CARDINAL;  (* not including header *)
  39.          CASE BOOLEAN OF
  40.             TRUE: nextBlock: blockPtr;
  41.          |  FALSE: contents:ARRAY[0..maxIndex] OF WORD;
  42.          END;
  43.          END;
  44.  
  45. VAR heapBottom,         (* first word in heap *)
  46.     heapTop,            (* last word in heap *)
  47.     masterBottom,        (* lowest point of masters section *)
  48.     firstMaster:ADDRESS;    (* first master ever allocated *)
  49.     freeList:blockPtr;        (* start of free list *)
  50.     masterPtr,            (* next available master *)
  51.     masterFreeList:handle;  (* start of master free list *)
  52.     blockHeaderWords,        (* # of words in a block header *)
  53.     minBlockSize,        (* smallest value for size field of a block *)
  54.     masterWords:CARDINAL;   (* # of words occupied by a master capability *)
  55.     cr:capRec;            (* a dummy record used for capabilities *)
  56.     
  57. PROCEDURE init;
  58. VAR heapWords:CARDINAL;
  59. BEGIN
  60.     heapBottom := getHeapBottom();
  61.     heapTop := getHeapTop();
  62.     blockHeaderWords := TSIZE(CARDINAL);
  63.     masterWords := TSIZE(masterCap);
  64.     minBlockSize := TSIZE(blockPtr);
  65.     freeList := blockPtr(heapBottom);
  66.     heapWords := cardinal(heapTop - heapBottom + address(1)) DIV bytesPerWord;
  67.     freeList^.size := heapWords - blockHeaderWords;
  68.     freeList^.nextBlock := NIL;
  69.     masterBottom := oneAfter(freeList);
  70.     firstMaster := subtractWords(masterBottom, masterWords);
  71.     masterPtr := handle(firstMaster);
  72.     masterFreeList := NIL;
  73.     moreMasters;
  74. END init;
  75.  
  76. PROCEDURE oneAfter(blockp:blockPtr):ADDRESS;
  77. (* Returns the address of 1 higher than block *)
  78. BEGIN
  79.     RETURN addWords(blockp, blockp^.size + blockHeaderWords);
  80. END oneAfter;
  81.  
  82.  
  83. PROCEDURE blockSize(c:capability):CARDINAL;
  84. VAR blockp:blockPtr;
  85. BEGIN
  86.     blockp := getBlock(c);
  87.     RETURN blockp^.size;
  88. END blockSize;
  89.  
  90. PROCEDURE getWord(c:capability; n:CARDINAL):WORD;
  91. VAR blockp:blockPtr;
  92. BEGIN
  93.     blockp := getBlock(c);
  94.     accessCheck(blockp, n);
  95.     RETURN blockp^.contents[n];
  96. END getWord;
  97.  
  98. PROCEDURE setWord(c:capability; n:CARDINAL; w:WORD);
  99. VAR blockp:blockPtr;
  100. BEGIN
  101.     blockp := getBlock(c);
  102.     accessCheck(blockp, n);
  103.     blockp^.contents[n] := w;
  104. END setWord;
  105.  
  106. PROCEDURE getBlock(c:capability):blockPtr;
  107. VAR master:handle;
  108. BEGIN
  109.     master := getMaster(c);
  110.     RETURN master^.blockp;
  111. END getBlock;
  112.  
  113. PROCEDURE getMaster(c:capability):handle;
  114. VAR cr:capRec;
  115.     master:handle;
  116. BEGIN
  117.     cr.cap := c;
  118.     master := handle(subtractWords(firstMaster, cr.offset));
  119.     IF cr.genCount <> master^.genCount THEN
  120.     fatal('generation counts disagree');
  121.     ELSE
  122.     RETURN master;
  123.     END;
  124. END getMaster;
  125.  
  126. PROCEDURE accessCheck(blockp:blockPtr; n:CARDINAL);
  127. BEGIN
  128.     IF n >= blockp^.size THEN
  129.     fatal('access out of bounds');
  130.     END;
  131. END accessCheck;
  132.  
  133. PROCEDURE allocate(nWords:CARDINAL):capability;
  134. VAR cr:capRec;
  135.     master:handle;
  136. BEGIN
  137.     master := allocMaster();
  138.     IF master <> NIL THEN
  139.     master^.blockp := NIL;    (* do this first to prevent this master from
  140.                      being involved in compaction *)
  141.     master^.blockp := allocBlock(nWords);
  142.     END;
  143.     cr.genCount := master^.genCount;
  144.     cr.offset := cardinal(firstMaster - ADDRESS(master)) DIV bytesPerWord;
  145.     RETURN cr.cap;
  146. END allocate;
  147.  
  148. PROCEDURE allocBlock(nWords:CARDINAL):blockPtr;
  149. VAR blockp:blockPtr;
  150. BEGIN
  151.     blockp := allocB(nWords);
  152.     IF blockp = NIL THEN
  153.     compact;
  154.     blockp := allocB(nWords);
  155.     END;
  156.     RETURN blockp;
  157. END allocBlock;
  158.  
  159. PROCEDURE allocB(nWords:CARDINAL):blockPtr;
  160. VAR currBlock, prevBlock, newBlock:blockPtr;
  161.     blockWords:CARDINAL;
  162. BEGIN
  163.     IF nWords < minBlockSize THEN
  164.     nWords := minBlockSize; (* can't allocate a smaller block than this *)
  165.     END;
  166.     blockWords := nWords + blockHeaderWords;
  167.     currBlock := freeList;
  168.     prevBlock := NIL;
  169.     WHILE currBlock <> NIL DO
  170.     IF blockWords + minBlockSize <= currBlock^.size THEN
  171.         (* split the block into two, returning the 1st part *)
  172.         newBlock := addWords(currBlock, blockWords);
  173.         newBlock^.size := currBlock^.size - blockWords;
  174.         newBlock^.nextBlock := currBlock^.nextBlock;
  175.         link(prevBlock, newBlock);
  176.         currBlock^.size := nWords;
  177.         RETURN currBlock;
  178.     ELSIF nWords <= currBlock^.size THEN (* return the whole block *)
  179.         link(prevBlock, currBlock^.nextBlock);
  180.         RETURN currBlock;
  181.     END;
  182.     prevBlock := currBlock;
  183.     currBlock := currBlock^.nextBlock;
  184.     END (* WHILE *);
  185.     RETURN NIL;
  186. END allocB;
  187.  
  188. PROCEDURE allocMaster():handle;
  189. (* The strategy here is as follows:
  190.     1. If the master free list isn't empty, take the first master.
  191.     2. If there is enough room between masterBottom and masterPtr to allocate
  192.        a master, do so.
  193.     3. If that fails, compact and allocate more masters, then try again.
  194. *)
  195. VAR h:handle;
  196. BEGIN
  197.   IF masterFreeList <> NIL THEN
  198.     h := masterFreeList;
  199.     masterFreeList := masterFreeList^.nextMaster;
  200.     RETURN h;
  201.   ELSE
  202.     IF addrLessThan(masterPtr, masterBottom) THEN
  203.     compact;
  204.     moreMasters;
  205.     END;
  206.     IF addrLessThan(masterPtr, masterBottom) THEN
  207.     RETURN NIL;
  208.     ELSE
  209.     masterPtr^.genCount := 0;
  210.     masterPtr := handle(subtractWords(masterPtr, masterWords));
  211.     RETURN addWords(masterPtr, masterWords);
  212.     END;
  213.   END;
  214. END allocMaster;
  215.  
  216. PROCEDURE moreMasters;
  217. (* Get highest block.  If its top isn't contiguous with the masters already
  218.    allocated, do nothing.
  219.    Else, try to allocate nMasters from its top; if it's too
  220.    small, allocate it all. 
  221. *)
  222. VAR prev, high:blockPtr;
  223.     nWords:CARDINAL;
  224. BEGIN
  225.     nWords := nMasters * masterWords;
  226.     IF freeList <> NIL THEN
  227.     high := freeList;
  228.     prev := NIL;
  229.     WHILE high^.nextBlock <> NIL DO
  230.         prev := high;
  231.         high := high^.nextBlock;
  232.     END;
  233.     (* high now points to highest block *)
  234.     IF oneAfter(high) = masterBottom THEN
  235.         (* top of block is contiguous with masters *)
  236.         IF high^.size >= minBlockSize + nWords THEN
  237.         (* chop off nWords words from high *)
  238.         DEC(high^.size, nWords);
  239.         masterBottom := oneAfter(high);
  240.         ELSIF high^.size >= minBlockSize + masterWords THEN
  241.         (* chop of enough for one master *)
  242.         DEC(high^.size, masterWords);
  243.         masterBottom := oneAfter(high);
  244.         ELSE
  245.         (* detach whole block *)
  246.         link(prev, high^.nextBlock);
  247.         masterBottom := high;
  248.         END;
  249.     END;
  250.     END;
  251. END moreMasters;
  252.         
  253.     
  254. PROCEDURE free(VAR c:capability);
  255. (* Return the block to the free list; put the master on the master free list.*)
  256. VAR master:handle;
  257. BEGIN
  258.     master := getMaster(c);
  259.     freeBlk(master^.blockp);
  260.     INC(master^.genCount);
  261.     master^.nextMaster := masterFreeList;
  262.     masterFreeList := master;
  263. END free;
  264.  
  265. PROCEDURE freeBlk(freeBlock:blockPtr);
  266. VAR currBlock, prevBlock:blockPtr; 
  267. BEGIN
  268.     IF NOT addrBetween(heapBottom, freeBlock, masterBottom) THEN
  269.     fatal("free: block not in heap");
  270.     ELSIF freeBlock = NIL THEN
  271.     fatal("free: attempt to free an already freed block");
  272.     ELSE
  273.     currBlock := freeList;
  274.     prevBlock := NIL;
  275.     WHILE (currBlock <> NIL) AND addrLessThan(currBlock, freeBlock) DO
  276.         prevBlock := currBlock;
  277.         currBlock := currBlock^.nextBlock;
  278.     END;
  279.     IF currBlock = NIL THEN
  280.         freeBlock^.nextBlock := NIL;
  281.         link(prevBlock, freeBlock);
  282.     ELSE  (* freeBlock belongs just before currBlock *)
  283.         freeBlock^.nextBlock := currBlock;
  284.         link(prevBlock, freeBlock);
  285.     END;
  286.     tryToMerge(prevBlock, freeBlock, currBlock);
  287.     END;
  288. END freeBlk;
  289.  
  290. PROCEDURE tryToMerge(lowBlock, middleBlock, highBlock:blockPtr);
  291. BEGIN
  292.     IF adjacent(middleBlock, highBlock) THEN
  293.     merge(middleBlock, highBlock);
  294.     END;
  295.     IF adjacent(lowBlock, middleBlock) THEN (* this should be impossible *)
  296.     merge(lowBlock, middleBlock);
  297.     END;
  298. END tryToMerge;
  299.  
  300. PROCEDURE adjacent(lowerBlock, higherBlock:blockPtr):BOOLEAN;
  301. BEGIN
  302.   RETURN 
  303.     (lowerBlock <> NIL) AND
  304.     (higherBlock <> NIL) AND 
  305.     (oneAfter(lowerBlock) = higherBlock);
  306. END adjacent;
  307.     
  308. PROCEDURE merge(lowerBlock, higherBlock:blockPtr);
  309. BEGIN
  310.     INC(lowerBlock^.size, higherBlock^.size + blockHeaderWords);
  311.     lowerBlock^.nextBlock := higherBlock^.nextBlock;
  312. END merge;
  313.     
  314. PROCEDURE resize(c:capability; nWords:CARDINAL);
  315. VAR blockp:blockPtr;
  316.     master:handle;
  317. BEGIN
  318.     master := getMaster(c);
  319.     blockp := allocBlock(nWords);
  320.     IF blockp <> NIL THEN
  321.     copyFromTo(master^.blockp, blockp, nWords);
  322.     freeBlk(master^.blockp);
  323.     master^.blockp := blockp;
  324.     END;
  325. END resize;
  326.  
  327.  
  328. PROCEDURE compact;
  329. (* compact blocks to low end of heap *)
  330. VAR lowPoint:blockPtr;
  331.     lowestHandle:handle;  
  332. BEGIN
  333.   IF freeList <> NIL THEN
  334.     lowPoint := heapBottom;
  335.     WHILE findLowestHandleNotLowerThan(lowPoint, lowestHandle) DO
  336.     IF lowestHandle^.blockp <> lowPoint THEN
  337.         lowPoint^.size := lowestHandle^.blockp^.size;
  338.         copyFromTo(lowestHandle^.blockp, lowPoint, lowPoint^.size);
  339.         lowestHandle^.blockp := lowPoint;
  340.     END;
  341.     lowPoint := oneAfter(lowPoint);
  342.     END;
  343.     (* now fix freelist *)
  344.     freeList := lowPoint;
  345.     freeList^.size := (cardinal(masterBottom-ADDRESS(freeList)) 
  346.                 DIV bytesPerWord) - blockHeaderWords;
  347.     freeList^.nextBlock := NIL; 
  348.   END;
  349. END compact;
  350.  
  351. PROCEDURE findLowestHandleNotLowerThan(low:blockPtr;VAR min:handle):BOOLEAN;
  352. (* The IF condition in the loop checks three things: 1. the handle under
  353.    consideration is <= than the current minimum; 2. it is >= the low point;
  354.    3. it is < masterBottom (hence not part of the master free list).
  355. *)
  356. VAR h:handle;
  357.     return:BOOLEAN;
  358.     mc: masterCap;
  359. BEGIN
  360.     h := firstMaster;
  361.     mc.blockp := blockPtr(maxAddress);
  362.     min := ADR(mc);
  363.     return := FALSE;
  364.     WHILE addrLessThan(masterPtr, h) DO
  365.     IF (NOT addrLessThan(min^.blockp, h^.blockp)) AND 
  366.        (NOT addrLessThan(h^.blockp, low)) AND
  367.        addrLessThan(h^.blockp, masterBottom) THEN
  368.         min := h;
  369.         return := TRUE;
  370.     END;
  371.     h := subtractWords(h, masterWords);
  372.     END;
  373.     RETURN return;
  374. END findLowestHandleNotLowerThan;
  375.  
  376. PROCEDURE copyFromTo(source, dest:blockPtr; nWords:CARDINAL);
  377. VAR i:CARDINAL;
  378. BEGIN
  379.     IF source^.size < nWords THEN
  380.     nWords := source^.size;
  381.     END;
  382.     FOR i := 0 TO nWords-1 DO
  383.     dest^.contents[i] := source^.contents[i];
  384.     END;
  385. END copyFromTo;
  386.  
  387. PROCEDURE link(prevBlock, linkBlock:blockPtr);
  388. BEGIN
  389.     IF prevBlock = NIL THEN
  390.     freeList := linkBlock;
  391.     ELSE
  392.     prevBlock^.nextBlock := linkBlock;
  393.     END;
  394. END link;
  395.  
  396. PROCEDURE addrBetween(low, middle, high:ADDRESS):BOOLEAN;
  397. BEGIN
  398.     RETURN (addrLessThan(low, middle) OR (low = middle)) AND
  399.        (addrLessThan(middle, high) OR (middle = high));
  400. END addrBetween;
  401.  
  402.     (*** debugging stuff ***)
  403.  
  404. PROCEDURE getFreeList():capability;
  405. (* for debugging only *)
  406. BEGIN
  407.     RETURN capability(freeList);
  408. END getFreeList;
  409.  
  410. PROCEDURE writeMap;
  411. VAR lowestFree, lowPoint:blockPtr;
  412.     lowestAlloc:handle;
  413.  
  414.     PROCEDURE writeFree;
  415.     BEGIN
  416.     WriteString("Free  ");
  417.     writeRelAddress(lowestFree);
  418.     WriteCard(lowestFree^.size, 4);
  419.     WriteLnString(" words");
  420.     END writeFree;
  421.  
  422. BEGIN    (* writeMap *)
  423.     WriteLn;
  424.     lowestFree := freeList;
  425.     lowPoint := heapBottom;
  426.     WHILE findLowestHandleNotLowerThan(lowPoint, lowestAlloc) DO
  427.     WHILE addrLessThan(lowestFree, lowestAlloc^.blockp) 
  428.         AND (lowestFree <> NIL) DO
  429.         writeFree;
  430.         lowestFree := lowestFree^.nextBlock;
  431.     END;
  432.     WriteString("Alloc ");
  433.     writeRelAddress(lowestAlloc^.blockp);
  434.     WriteCard(lowestAlloc^.blockp^.size, 4);
  435.     WriteString(" words; gen. count = ");
  436.     WriteCard(lowestAlloc^.genCount, 0); WriteLn;
  437.     lowPoint := oneAfter(lowestAlloc^.blockp);
  438.     END;
  439.     WHILE lowestFree <> NIL DO
  440.     writeFree;
  441.     lowestFree := lowestFree^.nextBlock;
  442.     END;
  443.     WriteLn;
  444.     WriteLnString("master free list:");
  445.     lowestAlloc := masterFreeList;
  446.     WHILE lowestAlloc <> NIL DO
  447.     writeRelAddress(lowestAlloc);
  448.     lowestAlloc := lowestAlloc^.nextMaster;
  449.     END;
  450.     WriteLn;
  451.     WriteString("firstMaster:  ");
  452.     writeRelAddress(firstMaster); WriteLn;
  453.     WriteString("masterPtr:    ");
  454.     writeRelAddress(masterPtr); WriteLn;
  455.     WriteString("masterBottom: ");
  456.     writeRelAddress(masterBottom); WriteLn;
  457. END writeMap;
  458.  
  459. PROCEDURE writeRelAddress(a:ADDRESS);
  460. BEGIN
  461.     WriteCard(cardinal(a - heapBottom), 4);
  462. END writeRelAddress;
  463.  
  464. BEGIN
  465.     init;
  466. END Alloc4.
  467. ddress(a:ADDRESS);
  468. BEGIN
  469.     WriteCard(cardinal(a - heapBottom), 4);
  470. END writeRelAddress;
  471.  
  472.